home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / forst.zoo / forst / src / words.s < prev   
Encoding:
Text File  |  1990-12-10  |  5.8 KB  |  287 lines
  1. ; WORDS.S: low-level access words for headers
  2. ; and their handlers.
  3. ; Copyright <c> John Redmond, 1989,1990
  4. ; Public domain for non-commercial use.
  5. ;
  6.     section    text
  7.     even
  8. ;
  9. lensize = 2
  10. macspecs = 4            ;2 words after name
  11. pointers = 8            ;2 fields
  12. overmacs = macspecs+1
  13. threeflds = macspecs+pointers
  14. allflds = threeflds+lensize
  15. nxtnfa = pointers+lensize
  16. frstcfa = nxtnfa
  17.  
  18. ; _BFIND: The pointer to string is expected on the stack.
  19. ; If a match is found, the code field address is returned
  20. ; with +1 or -1, otherwise the string pointer is returned with 0.
  21. _bfind: movem.l a2-a4,-(a7)
  22.     bsr    upper        ;string in pocket to upper case
  23.     bsr    _there
  24.     pop    a0        ;pointer to headers
  25.     pop    a4        ;address of pocket
  26. .bflp:
  27. ;point to name in next header
  28.     move.w    -(a0),d0
  29.     beq    .notfnd        ;zero if already at last header
  30.     suba.w    d0,a0        ;point to previous header
  31.     move.l    a0,a2        ;working copy of pointer
  32. ;try for a match
  33.     move.l    a4,a1        ;pointer to match string
  34.     move.b    (a2)+,d0
  35.     and.l    #$3f,d0        ;mask off name length & leave smudge bit
  36.     cmp.b    (a1)+,d0
  37.     bne    .bflp        ;length is wrong
  38.     subq.l    #1,d0
  39. .matchlp: move.b (a2)+,d1
  40.     and.b    #$7f,d1        ;mask off high bit
  41.     cmp.b    (a1)+,d1
  42.     bne    .bflp        ;character mismatch
  43.     dbra    d0,.matchlp
  44.     move.w    a2,d0
  45.     btst    #0,d0
  46.     beq    .match9        ;if address is even
  47.     addq.l    #1,a2
  48. .match9: addq.l #4,a2        ;skip length and macro flag
  49.     push    a2        ;cfa of word
  50.     move.l    #-1,d0        ;return -1
  51.     btst    #6,(a0)        ;test immediate bit
  52.     beq    .notimm
  53.     neg.l    d0        ;return +1
  54. .notimm: push    d0        ;true flag
  55.     bra    .fx
  56. .notfnd: push    a4        ;return pocket address
  57.     clr.l    -(a6)        ;with false flag
  58. .fx:    movem.l (a7)+,a2-a4
  59.     rts
  60. ;
  61. _traverse: movem.l (a6)+,d0/a0
  62. .trlp:    add.l    d0,a0
  63.     btst    #7,(a0)
  64.     beq    .trlp
  65.     push    a0
  66.     rts
  67. ;
  68. _cton:    pop    a0
  69.     subq.l    #overmacs,a0
  70.     push    a0
  71.     push    #-1
  72.     bsr    _traverse    ;get nfa
  73.     rts
  74. ;
  75. _ntoc:    push    #1
  76.     bsr    _traverse
  77.     add.l    #overmacs,(a6)
  78.     rts
  79. ;
  80. codehead: move.l (a0),d0    ;get code offset
  81.     lea    _const,a1
  82.     suba.l    a5,a1        ;code offset of constant
  83.     cmp.l    a1,d0
  84.     bne    .cy        ;not a constant header
  85.     adda.l    #nxtnfa,a0    ;nfa of next header
  86.     lea    hp,a1
  87.     move.l    (a1),d0
  88.     add.l    a5,d0
  89.     cmp.l    a0,d0
  90.     bls    .cx        ;no more headers
  91.     push    a0
  92.     bsr    _ntoc
  93.     pop    a0        ;cfa of next header
  94.     bra    codehead    ;try again
  95. .cx:    move.l    #0,a0        ;set zero flag
  96. .cy:    rts
  97. ;
  98. discard: move.l (a6),a0
  99.     bsr    codehead    ;get a header with its own code
  100.     beq    .d5        ;no code to delete
  101.     lea    cp,a1
  102.     move.l    4(a0),(a1)    ;correct code pointer
  103. .d5:    bsr    _cton
  104.     pop    d0        ;nfa of original header
  105.     sub.l    a5,d0        ;subtract index to get offset
  106.     lea    hp,a0
  107.     move.l    d0,(a0)        ;correct header pointer
  108.     rts
  109. ;
  110. castore: bsr    _there
  111.     pop    a0
  112.     suba.l    #frstcfa,a0    ;point to cfa
  113.     pop    d0
  114.     sub.l    a5,d0        ;code offset
  115.     move.l    d0,(a0)
  116.     rts
  117. ;
  118. do_ptrs:
  119.     suba.l    a5,a0        ;convert to offset
  120.     push    a0
  121.     bsr    _hcomma
  122.     lea    cp,a0
  123.     push    (a0)
  124.     bsr    _hcomma        ;offset ^value in pfa
  125.     rts
  126. ;
  127. header:    bsr    name        ;return address of pocket
  128.     bsr    _align
  129.     bsr    _halign
  130.     bsr    _there
  131.     move.l    (a6),-(a7)    ;save copy of nfa
  132.     move.l    4(a6),a0    ;pocket address
  133.     clr.l    d0
  134.     move.b    (a0),d0        ;name length
  135.     addq.l    #1,d0
  136.     push    d0
  137.     move.l    d0,-(a7)    ;save length for later
  138.     bsr    _cmove        ;move name into place
  139.     push    (a7)+        ;length
  140.     bsr    _hallot
  141.     bsr    _halign
  142.     bsr    _there
  143.     pop    a0
  144.     tas    -1(a0)        ;set bit 7 at end of name
  145.     move.l    (a7)+,a0    ;get nfa back
  146.     tas    (a0)        ;set bit 7 of name length
  147.     push    #0
  148.     bsr    _hcomma        ;ready for macro flag and length
  149.     rts            ;return address of start of header
  150. ;    
  151. dolength: lea    pocket,a0    ;add in head length at end of head
  152.     move.l    (a0),a0
  153.     moveq.l    #0,d0
  154.     move.b    (a0),d0
  155.     add.w    #(threeflds+1),d0 ;length of dimensioned name + 12
  156.     moveq.l    #1,d1
  157.     and.w    d0,d1
  158.     add.w    d1,d0        ;add 1 if length odd
  159.     lea    hp,a0
  160.     move.l    (a0),a1
  161.     add.l    #lensize,(a0)
  162.     adda.l    a5,a1
  163.     move.w    d0,(a1)
  164.     rts
  165. ;
  166. _immediate: bsr _last
  167.     pop    a0
  168.     bset    #6,(a0)
  169.     rts
  170. ;
  171. _smudge: bsr    _last
  172.     pop    a0
  173.     eori.b    #$20,(a0)
  174.     rts
  175. ;
  176. ;*******************************************************;
  177. ;                            ;
  178. ; The handlers for the separated headers        ;
  179. ;                            ;
  180. ;*******************************************************;
  181. ;
  182. fnfa:    bsr    _head
  183.     sub.l    #overmacs,(a6)
  184.     push    #-1
  185.     bsr    _traverse    ;get nfa
  186.     rts
  187. ;
  188. headlen: moveq.l #0,d0
  189.     move.b    (a0),d0
  190.     and.l    #$1f,d0        ;length of name
  191.     move.l    d0,d1
  192.     and.l    #1,d1
  193.     eor.l    #1,d1
  194.     add.b    d1,d0        ;extra byte if length is even
  195.     add.b    #(allflds+1),d0    ;total length of header (add 1+3*4+2)
  196.     rts
  197. ;
  198. _from:    bsr    fnfa
  199.     pop    a0
  200.     suba.l    a5,a0
  201.     lea    chop,a1
  202.     move.l    a0,(a1)        ;start of header removal
  203.     bsr    _pad
  204.     pop    a0
  205.     lea    hbase,a1
  206.     move.l    a0,(a1)        ;keep selected headers here
  207.     lea    hnow,a1
  208.     move.l    a0,(a1)        ;place for next header
  209.     lea    hlen,a0
  210.     clr.l    (a0)        ;none so far
  211.     rts
  212. ;
  213. _keep:    movem.l a2-a3,-(a7)
  214.     bsr    fnfa
  215.     move.l    (a6),a0        ;copy nfa
  216.     bsr    headlen        ;length in d0
  217.     lea    hlen,a1
  218.     add.l    d0,(a1)        ;increase length of stored headers
  219.     lea    hnow,a2
  220.     move.l    (a2),a3        ;where to move this header
  221.     add.l    d0,(a2)        ;increase store pointer
  222.     push    a3
  223.     push    d0
  224.     bsr    _cmove        ;shift header
  225.     movem.l (a7)+,a2-a3
  226.     rts
  227. ;
  228. _hide:    bsr    fnfa
  229.     pop    a0
  230.     bsr    headlen        ;length in d0
  231.     lea    (a0,d0.l),a1
  232.     push    a1
  233.     push    a0
  234.     lea    hp,a0
  235.     move.l    (a0),d1
  236.     add.l    a5,d1        ;^free header space
  237.     sub.l    d0,(a0)        ;adjust hp back
  238.     sub.l    a1,d1        ;size of header block to move
  239.     push    d1
  240.     bsr    _cmove
  241.     rts
  242. ;
  243. _public: move.l a2,-(a7)
  244.     lea    hp,a0
  245.     lea    chop,a1
  246.     move.l    (a1),(a0)    ;cut headers back
  247.     move.l    (a0),a1
  248.     adda.l    a5,a1        ;dest for header move
  249. ;
  250.     lea    hlen,a2
  251.     move.l    (a2),d0        ;length of saved heads
  252.     add.l    d0,(a0)        ;advance hp
  253. ;
  254.     lea    hbase,a2
  255.     move.l    (a2),a2
  256.     push    a2        ;source
  257.     push    a1        ;dest
  258.     push    d0        ;length
  259.     bsr    _cmove
  260.     move.l    (a7)+,a2
  261.     rts
  262. ;
  263.     section    data
  264.     even
  265. ;
  266.     dc.b    $88,'TRAVERSE',$a0
  267.     ptrs    _traverse,22
  268. ;
  269.     dc.b    $84,'LAST',$a0
  270.     ptrs    _last,18
  271. ;
  272.     dc.b    $84,'HEAD',$a0
  273.     ptrs    _head,18
  274. ;
  275.     dc.b    $84,'FROM',$a0
  276.     ptrs    _from,18
  277. ;
  278.     dc.b    $84,'KEEP',$a0
  279.     ptrs    _keep,18
  280. ;
  281.     dc.b    $84,'HIDE',$a0
  282.     ptrs    _hide,18
  283. ;
  284.     dc.b    $86,'PUBLIC',$a0
  285.     ptrs    _public,20
  286. ;
  287.